;;; Constant & Unknown help
(defpackage :cuhelp-mixin
  (:use :cl)
  (:nicknames :chm)
  (:export :constants-and-unknown-help-mixin
           :instruction-condition
           :overlay-on-mistake
           :overlay-on-hint
           :computation-condition))

(in-package :cuhelp-mixin)

(defclass constants-and-unknown-help-mixin ()
  ((current-constant-hint :initform nil :accessor current-constant-hint)
   (current-unknown-hint :initform nil :accessor current-unknown-hint)
   (overlay-on-mistake :initarg :green-overlay-on-mistake :initform nil :accessor overlay-on-mistake)
   (overlay-on-hint :initarg :green-overlay-on-hint :initform nil :accessor overlay-on-hint)
   (computation-condition :initarg :computation-condition :initform :split :accessor computation-condition)))

(defmethod exp:state-dump append (exp (state constants-and-unknown-help-mixin))
  (list :green-overlay-on-mistake (overlay-on-mistake state)
        :green-overlay-on-hint (overlay-on-hint state)
        :computation-condition (computation-condition state)))

(defgeneric instruction-condition (obj)
  (:documentation "Return the instruction condition for the
problem. This must be implemented by the inheriting class."))

(defclass green-box (d:argument)
  ((xfont :initform (gwee:open-font "serifitalic.ttf" 24) :accessor xfont)))

(defclass unknown-green-box (green-box)
  ())

(defclass constant-green-box (green-box)
  ())

(defclass combo-green-box (green-box)
  ((unknown-value :initarg :unknown-value :accessor unknown-value)
   (constant-value :initarg :constant-value :accessor constant-value)))

(defmethod u:copy-slots progn ((from combo-green-box) (to combo-green-box))
  (u:simple-copy-slots from to 'unknown-value 'constant-value))

(defmethod d:draw-node ((node green-box) (view dtm:draw-tree-mixin))
  (dtm::draw-argument-background node view)
  (gwee:draw-ellipse view (1+ (geom:centerx node)) (1+ (geom:centery node))
                    (- (u:half (geom:width node)) 3)
                    (- (u:half (geom:height node)) 5)
                    :filled t
                    :color (gwee:color 150 250 150))
  (when (d:quantity node)
    (gwee:draw-text view 
                    (u:string2 (d:quantity node))
                    (1+ (boxes.util::center-inside (geom:width node)
                                                   (boxes.util::text-width (d:quantity node) (xfont node))
                                                   (geom:x node)))
                    (+ (boxes.util::center-inside (geom:height node)
                                               (sdl:get-font-height :font (xfont node))
                                               (geom:y node))
                       2)
                    :color (d:foreground node)
                    :font (xfont node)))
  (dtm::draw-argument-arrows node view))

(defmethod d:quantity ((arg unknown-green-box))
  (let ((v (slot-value arg 'd:quantity)))
    (format nil "~aX" (cond ((eql v 1) "")
                            ((eql v -1) "-")
                            (t v)))))

(defmethod d:quantity ((arg combo-green-box))
  (let ((uv (unknown-value arg))
        (cv (constant-value arg)))
    (format nil "~a~aX"
            (cond ((zerop cv) "")
                  (t cv))
            (cond ((eql uv 1) (if (zerop cv) "" "+"))
                  ((plusp uv) (if (zerop cv) uv (format nil "+~a" uv)))
                  ((eql uv -1) "-")
                  (t uv)))))

(defun green-box-prep-arg (node top-args cv uv for)
  (declare (ignore top-args))
  (ecase for
    (:unknown
     (change-class node 'unknown-green-box
                   :quantity uv))
    (:constant
     (change-class node 'constant-green-box
                   :quantity cv))
    (:both
     (change-class node 'combo-green-box
                   :unknown-value uv
                   :constant-value cv))))

(defun green-box-last-state-help (hint cv uv instruction-condition)
  (declare (ignore hint cv uv instruction-condition))
  "This illustrates how to fill in the blue tiles.")

(defun green-box-enter-help (hint cv uv bottom-cvs bottom-uvs instruction-condition)
  (if (eq instruction-condition :discovery)
      "Enter a number."
      (ecase (lt::hint-which hint)
        (:unknown (format nil "Enter ~d because the sum of the X's is ~d (~aX~a~aX = ~aX)" uv uv (first bottom-uvs) (second bottom-uvs) (third bottom-uvs)  uv))
        (:constant (format nil "Enter ~d because the sum of the numbers is ~d (~a~a~a = ~a)" cv cv (first bottom-cvs) (second bottom-cvs) (third bottom-cvs) cv)))))

(defun green-box-complete-help (hint cv uv bottom-cvs bottom-uvs instruction-condition)
  (let ((early (green-box-last-state-help hint cv uv instruction-condition))
        (enter (green-box-enter-help hint cv uv bottom-cvs bottom-uvs instruction-condition)))
    (format nil "~a~%~a" early enter)))

(defun green-boxify-unknown-other (input)
  (change-class (d:box-right-arg (tree:parent input))
                'unknown-green-box
                :quantity 1))

(defun green-boxify-unknown-parent (input)
  (change-class (tree:parent (tree:parent input))
                'unknown-green-box
                :quantity (d:quantity input)))

(defun clear-green-tiles (tree)
  (d:funcall-on-tree (lambda (n)
                       (change-class n 'd:argument :quantity nil :background (gwee:gray 240)))
                     tree
                     :only-type 'green-box))

(defun prep-loop (root top for only-top-args-p prep-arg-fn)
  "Walk the tree from TOP to ROOT, calling PREP-ARG-FN on each
tile. This is for changing the tiles to green boxes."
  (let* ((top-args (tree:parents top))
         bottom-cvs bottom-uvs
         other-cv other-uv
         final-cv final-uv)
    (labels ((value (node)
               (if (typep node 'd:input-argument)
                   (d:answer node)
                   (d:quantity node)))
             (new-value (value box node)
               (if (eq node (d:box-left-arg box))
                   (funcall (d:quantity (d:box-operator-arg box))
                            value
                            (d:quantity (d:box-right-arg box)))
                   (funcall (d:quantity (d:box-operator-arg box))
                            (d:quantity (d:box-left-arg box))
                            value)))
             (walk (node cv uv)
               (funcall prep-arg-fn node top-args cv uv for)
               (let ((box (tree:parent node)))
                 (cond
                   (only-top-args-p)
                   ((and (eq box root)
                         (not (and (value (d:box-left-arg box))
                                   (value (d:box-right-arg box)))))
                    ;; save these values for when we come down the other side
                    (setf other-cv cv other-uv uv))
                   ((eq box root)
                    (let* ((straightp (eq node (d:box-left-arg box)))
                           (new-cv (if straightp
                                       (funcall (d:quantity (d:box-operator-arg box))
                                                cv other-cv)
                                       (funcall (d:quantity (d:box-operator-arg box))
                                                other-cv cv)))
                           (new-uv (if straightp
                                       (funcall (d:quantity (d:box-operator-arg box))
                                                uv other-uv)
                                       (funcall (d:quantity (d:box-operator-arg box))
                                                other-uv uv))))
                      (setf final-cv new-cv
                            final-uv new-uv
                            bottom-cvs (if straightp
                                           (list cv (d:quantity (d:box-operator-arg box)) other-cv)
                                           (list other-cv (d:quantity (d:box-operator-arg box)) cv))
                            bottom-uvs (if straightp
                                           (list uv (d:quantity (d:box-operator-arg box)) other-uv)
                                           (list other-uv (d:quantity (d:box-operator-arg box)) uv)))))
                   (t
                    (let ((other (if (eq node (d:box-left-arg box))
                                     (d:box-right-arg box)
                                     (d:box-left-arg box)))
                          (next-node (tree:parent box))
                          new-cv new-uv)
                      (if (find (d:quantity (d:box-operator-arg box)) '(+ -))
                          (if (and (eq node (d:box-right-arg box))
                                   (eq (d:quantity (d:box-operator-arg box)) '-))
                              (setf new-cv (- (d:quantity other) cv)
                                    new-uv (- uv))
                              (setf new-cv (funcall (d:quantity (d:box-operator-arg box)) cv (d:quantity other))
                                    new-uv uv))
                          (setf new-cv (new-value cv box node)
                                new-uv (new-value uv box node)))
                      (walk next-node new-cv new-uv)))))))
      (mapc (lambda (n)
              (walk n 0 1))
            top-args)
      (values final-cv final-uv bottom-cvs bottom-uvs))))

(defun next-input-argument (root)
  "Start at the top aka unknown input arg."
  (first (sort (d:collect-on-tree (lambda (n)
                                    (not (string= (u:string2 (d:quantity n))
                                                  (u:string2 (d:answer n)))))
                                  root
                                  :only-type 'd:input-argument)
               '> :key 'tree:depth)))

(defun add-last-state-overlay-helper (last-state-root arg &key bothp only-top-args-p)
  "Change the tiles on the left diagram to be green boxes for the specified arg."
  (let* ((bottom (lt::find-bottom-box last-state-root (d:selected-nodes last-state-root)))
         (top (lt::find-top-box last-state-root (d:selected-nodes last-state-root))))
    (multiple-value-bind (hint mistake) (guide::fill-instructions-for-arg arg)
      (multiple-value-bind (cv uv bottom-cvs bottom-uvs) (prep-loop bottom top (if bothp
                                                                                   :both
                                                                                   (lt::hint-which hint))
                                                                    only-top-args-p
                                                                    'green-box-prep-arg)
        (values bottom cv uv bottom-cvs bottom-uvs hint mistake)))))

(defun green-box-empties-in-root (problem arg hint)
  "Change the appropriate tiles in the right diagram to be green
boxes. ARG is either the unknown blue tile or the constant blue tile."
  (let ((op (d:box-operator-arg (tree:parent arg))))
    (d:point-to-nodes (d:root (p:diagram problem)) arg)
    (clear-green-background (d:root (p:diagram problem)))
    (setf (d:background op) (gwee:color 0 255 0))
    (ecase (lt::hint-which hint)
      (:unknown
       (green-boxify-unknown-other arg)
       (d:update-diagram-view (p:diagram problem)))
      (:constant
       (let ((input (d:box-left-arg (tree:child (d:box-right-arg (tree:parent arg))))))
         (green-boxify-unknown-other input)
         (green-boxify-unknown-parent input)
         (d:update-diagram-view (p:diagram problem)))))))

(defun clear-green-background (root)
  (let ((green (gwee:color 0 255 0)))
    (d:funcall-on-tree (lambda (n)
                         (when (sdl:color= (d:background n) green)
                           (setf (d:background n) (gwee:gray 240))))
                       root
                       :only-type 'd:argument)))

;; (defun full-green-boxify-last-state (problem)
;;   (clear-help problem)
;;   (multiple-value-bind (arg bottom cv uv bottom-cvs bottom-uvs hint mistake) (green-boxify-helper (d:root (p:diagram problem)) (d:root (bt:last-state problem)) t)
;;     (declare (ignore bottom))
;;     (clear-green-background (d:root (p:diagram problem)))
;;     (green-box-empties-in-root problem arg hint)
;;     (p:display-message problem :hint (green-box-enter-help hint cv uv bottom-cvs bottom-uvs (instruction-condition problem)))
;;     (when mistake
;;       (p:display-message problem :error mistake))
;;     (d:update-diagram-view (bt:last-state problem))))

;; (defun partial-green-boxify-last-state (problem)
;;   (clear-help problem)
;;   (multiple-value-bind (arg bottom cv uv bottom-cvs bottom-uvs hint mistake) (green-boxify-helper (d:root (p:diagram problem)) (d:root (bt:last-state problem)) nil)
;;     (declare (ignore bottom bottom-cvs bottom-uvs))
;;     (d:point-to-nodes (d:root (p:diagram problem)) arg)
;;     (let ((op (d:box-operator-arg (tree:parent arg))))
;;       (clear-green-background (d:root (p:diagram problem)))
;;       (setf (d:background op) (gwee:color 0 255 0))
;;       (green-box-empties-in-root problem arg hint)
;;       (p:display-message problem :hint (green-box-early-help hint cv uv (instruction-condition problem)))
;;       (when mistake
;;         (p:display-message problem :error mistake))
;;       (d:update-diagram-view (bt:last-state problem)))))

(defun green-overlay-present-p (state &optional (root (d:root (bt:last-state state))))
  (and root
       (d:find-if-on-tree (constantly t)
                          root
                          :only-type 'cuhelp-mixin::green-box)))

(defun add-overlay-to-last-state (problem &optional (node (next-input-argument (d:root (p:diagram problem)))))
  "Only the left diagram gets green boxes for the specified node."
  (clear-help problem)
  (add-last-state-overlay-helper (d:root (bt:last-state problem)) node :bothp (ecase (computation-condition problem)
                                                                                (:both t)
                                                                                (:split nil)))
  (multiple-value-bind (hint mistake) (guide::fill-instructions-for-arg node)
    (p:display-message problem :hint (green-box-last-state-help hint nil nil (instruction-condition problem)))
    (when mistake
      (p:display-message problem :error mistake))
    (d:update-diagram-view (bt:last-state problem))))

(defun add-overlays-to-both-diagrams (problem &optional (node (next-input-argument (d:root (p:diagram problem)))))
  "Both diagrams left&right get green box overlays."
  (clear-help problem)
  (multiple-value-bind (bottom cv uv bottom-cvs bottom-uvs hint mistake) (add-last-state-overlay-helper (d:root (bt:last-state problem)) node
                                                                                                        :bothp (ecase (computation-condition problem)
                                                                                                                 (:both t)
                                                                                                                 (:split nil)))
    (declare (ignore bottom))
    (green-box-empties-in-root problem node hint)
    (p:display-message problem :hint (green-box-complete-help hint cv uv bottom-cvs bottom-uvs (instruction-condition problem)))
    (when mistake
      (p:display-message problem :error mistake))
    (d:update-diagram-view (bt:last-state problem))))

(defun add-overlay-to-current-state (problem)
  "Only the diagram on the right gets green boxes."
  (let ((input (next-input-argument (d:root (p:diagram problem)))))
    (multiple-value-bind (hint mistake) (guide::fill-instructions-for-arg input)
      (green-box-empties-in-root problem input hint)
      (p:display-message problem :hint "Enter a number.")
      (when mistake
        (p:display-message problem :error mistake))
      (d:update-diagram-view (bt:last-state problem)))))

(defun clear-help (state)
  (clear-green-tiles (d:root (p:diagram state)))
  (when (d:root (bt:last-state state))
    (clear-green-tiles (d:root (bt:last-state state)))))

(defmethod p:navigate-clean-up progn ((state constants-and-unknown-help-mixin) how)
  (clear-help state)
  (clear-green-background (d:root (p:diagram state))))

(defmethod p:finish-input-arguments-collapse progn ((state constants-and-unknown-help-mixin))
  (clear-help state)
  (clear-green-background (d:root (p:diagram state))))

(defmethod as:finish-collapsed-argument progn ((state constants-and-unknown-help-mixin) node)
  (clear-help state)
  (clear-green-background (d:root (p:diagram state)))
  (bt::refresh-diagram state (bt:last-state state)))

(defmethod bt:before-undo-hook progn ((state constants-and-unknown-help-mixin))
  (clear-help state))
